home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / PAINT.PAK / RECT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-06-08  |  2.5 KB  |  90 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows: Paint Demo         }
  4. {   Rect (Rectangles) unit                       }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit Rect;
  10.  
  11. { This unit augments the support for type TRect.
  12. }
  13.  
  14. interface
  15.  
  16. uses WinTypes, WinProcs;
  17.  
  18. type
  19.   RectArray = array[0..3] of TRect;      { To return results from rect ops }
  20.  
  21. { Compute Rect1 - Rect2 as (up to 4) non-overlapping rectangles.
  22.   Returns the number of non-null resulting rectangles.
  23. }
  24. function SubtractRect(var Result: RectArray; var Rect1,
  25.   Rect2: TRect): Integer;
  26.               
  27. implementation
  28.  
  29. { Compute Rect1 - Rect2 as (up to 4) non-overlapping rectangles.
  30.   Returns the number of non-null resulting rectangles.
  31. }
  32. function SubtractRect(var Result: RectArray; var Rect1,
  33.   Rect2: TRect): Integer;
  34.               
  35.   function Max(A, B: Integer): Integer;
  36.   begin
  37.     if A > B then Max := A else Max := B;
  38.   end;
  39.  
  40.   function Min(A, B: Integer): Integer;
  41.   begin
  42.     if A < B then Min := A else Min := B;
  43.   end;
  44.  
  45. var
  46.   I: Integer;
  47. begin
  48.   I := IntersectRect(Result[0], Rect1, Rect2);
  49.   if I = 0 then
  50.   begin
  51.     with Rect1 do
  52.       SetRect(Result[0], Left, Top, Right, Bottom);
  53.     I := 1;                        { difference is Rect1 }
  54.   end
  55.   else
  56.     if not EqualRect(Result[0], Rect1) then  { else difference is empty }
  57.     begin
  58.       I := 0;
  59.       if Rect2.Top > Rect1.Top then        { compute 'top' rectangle }
  60.         with Rect1 do
  61.           begin
  62.             SetRect(Result[I], Left, Top, Right, Rect2.Top);
  63.           Inc(I);
  64.         end;
  65.       if Rect2.Bottom < Rect1.Bottom then  { compute 'bottom' rectangle }
  66.         with Rect1 do
  67.         begin
  68.           SetRect(Result[I], Left, Rect2.Bottom, Right, Bottom);
  69.         Inc(I);
  70.         end;
  71.       if Rect2.Left > Rect1.Left then      { compute 'left' rectangle }
  72.       begin                   { note that top and bottom }
  73.        SetRect(Result[I], Rect1.Left,     { should not overlap }
  74.       Max(Rect1.Top, Rect2.Top), Rect2.Left,
  75.           Min(Rect1.Bottom, Rect2.Bottom));
  76.         Inc(I);
  77.       end;
  78.       if Rect2.Right < Rect1.Right then    { ditto 'right' rectangle }
  79.       begin
  80.         SetRect(Result[I], Rect2.Right, Max(Rect1.Top, Rect2.Top),
  81.           Rect1.Right, Min(Rect1.Bottom, Rect2.Bottom));
  82.         Inc(I);
  83.       end;
  84.   end;
  85.   SubtractRect := I;                 { number of valid rectangles }
  86. end;
  87.  
  88. end.
  89.  
  90.